/* GUI CONVERTED from rssupa1.p (converter v1.76) Sun Feb 24 20:08:42 2002 */
/* rssupa1.p - Release Management Supplier Schedules                          */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                        */
/* All rights reserved worldwide.  This is an unpublished work.               */
/* $Revision: 1.8.1.4 $                                                         */
/*V8:ConvertMode=Report                                                       */
/* REVISION: 8.5            CREATED: 08/05/95   BY: *G2BF* Sanjay Patil       */
/* REVISION: 8.5      LAST MODIFIED: 04/23/97   BY: *H0WH* Aruna Patil        */
/* REVISION: 8.6E     LAST MODIFIED: 02/23/98   BY: *L007* A. Rahane          */
/* REVISION: 8.6E     LAST MODIFIED: 05/20/98   BY: *K1Q4* Alfred Tan         */
/* REVISION: 8.6E     LAST MODIFIED: 10/04/98   BY: *J314* Alfred Tan         */
/* REVISION: 9.1      LAST MODIFIED: 11/17/99   BY: *N04H* Vivek Gogte        */
/* REVISION: 9.1      LAST MODIFIED: 08/12/00   BY: *N0KP* myb                */
/* REVISION: 9.1      LAST MODIFIED: 10/06/00   BY: *N0RT* Jean Miller        */
/* $Revision: 1.8.1.4 $    BY: Anitha Gopal          DATE: 02/17/02  ECO: *N19G*  */
/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/

/* SUBCONTRACT SUPPLIER SCHEDULE UPDATE SUBPROGRAM */


/*GUI preprocessor directive settings */
&SCOPED-DEFINE PP_GUI_CONVERT_MODE REPORT

{mfdeclre.i}
{gplabel.i}

/* ********** Begin Translatable Strings Definitions ********* */

&SCOPED-DEFINE rssupa1_p_1 "Alloc %"
/* MaxLen: Comment: */

&SCOPED-DEFINE rssupa1_p_2 "Calendar!Adj. Date"
/* MaxLen: Comment: */

&SCOPED-DEFINE rssupa1_p_3 "Ship/Dlvy!Adj. Date"
/* MaxLen: Comment: */

&SCOPED-DEFINE rssupa1_p_4 "Safety LT!Adj. Date"
/* MaxLen: Comment: */

&SCOPED-DEFINE rssupa1_p_5 "Qty Ordered x!Alloc %"
/* MaxLen: Comment: */

/* ********** End Translatable Strings Definitions ********* */

/* INPUT PARAMS */
define input parameter wotype like wo_type no-undo.
define input parameter wopart like wo_part no-undo.
define input parameter wosite like wo_site no-undo.
define input parameter pod_recid as recid no-undo.
define input parameter start_date as date no-undo.
define input parameter asof_date as date no-undo.
define input parameter report_yn like mfc_logical no-undo.
define input parameter header_desc as character no-undo.
define input-output parameter warn_ct as integer no-undo.

/* OUTPUT PARAMS */
define shared workfile work_schd like schd_det.

define shared variable ship_dlvy_code as character.
define shared variable interval_code as character.
define shared variable req_dt as date.
define shared variable req_qty as decimal.
define shared variable week_offset as integer.
define shared variable shipto_calid as character.
define shared variable resch_ct as integer.
define shared variable resch_dt as date extent 999 no-undo.
define shared variable resch_qty as decimal extent 999 no-undo.
define shared variable working_hours as decimal extent 999 no-undo.
define shared variable resch_stat as character.
define shared variable wo_recno as recid.

define variable work_qty like wo_qty_ord no-undo.
define variable shipfrom_date as date no-undo.
define variable shipfrom_time as character no-undo.
define variable arrive_date as date no-undo.
define variable arrive_time as character no-undo.
define variable ret_status as character no-undo.
define variable ship_dlvy_date as date no-undo.
define variable safety_date as date no-undo.
define variable alloc_percent as decimal label {&rssupa1_p_1}
   format ">>9" no-undo.
define variable begstr as character no-undo.
define variable open_qty as decimal no-undo.
define variable match_wr as logical no-undo.
define variable routing as character no-undo.
define variable l_tmp_string1 as character no-undo.
define variable l_tmp_string2 as character no-undo.

find pod_det
   where recid(pod_det) = pod_recid no-lock.
find po_mstr
   where po_nbr = pod_nbr no-lock.

for each wo_mstr no-lock
   where wo_type       = wotype
   and   wo_part       = wopart
   and   wo_joint_type = ""
   and   wo_site       = wosite
   and   wo_status     <> "b"
   and   wo_status     <> "c"
   use-index wo_type_part:

   assign
      match_wr = no
      routing = if wo_routing > ""
                then
                   wo_routing
                else
                   wo_part.

   find first wr_route
      where wr_lot = wo_lot
      no-lock no-error.

   /* VALIDATE AND EXPLODE PLANNED ORDERS WITH UNEXPLODED ROUTINGS */
   if (not available wr_route)
   and (wo_status = "P" or wo_status = "F")
   then do:
      /* VALIDATE THIS ROUTING OPERATION (wr_route) */
      for each ro_det no-lock
         where ro_routing = routing
         and  (ro_start   = ? or ro_start <= wo_rel_date)
         and  (ro_end     = ? or ro_end   >= wo_rel_date):

         if ro_po_nbr = pod_nbr
         and ro_po_line = pod_line
         then do:
            match_wr = yes.
            leave.
         end. /* PO MATCHING */
      end. /* FOR EACH ro_det NO-LOCK */
      if match_wr
      then do:
         /* EXPLODE ROUTINGS FOR PLANNED ORDERS THAT DO NOT HAVE THEM */
         wo_recno = recid(wo_mstr).
         {gprun.i ""woworlc.p""}
         {gprun.i ""woworle.p""}
      end. /* IF match_wr */
   end. /* IF NOT AVAILABLE wr_route */

   if not available wr_route
   and not match_wr
   then
      next. /* wo_mstr */

   /* PROCESS ORDERS NOW THAT THEY HAVE EXPLODED ROUTINGS */
   for each wr_route no-lock
      where wr_lot     = wo_lot
      and   wr_qty_ord > 0
      and   wr_qty_ord > wr_qty_comp
      and   wr_status  <> "C":

      match_wr = no.

      if wr_po_nbr = pod_nbr
      and wr_po_line = pod_line
      then
         match_wr = yes.

      if not match_wr
      then
         next. /* wr_route */

      /* NOW GET THE ALLOCATION PERCENT FOR THE PO PART AS OF */
      /* THE RECALCULATED DATE */

      assign
         l_tmp_string1 = string(pod_site,"x(8)")
            + string(pod_part, "x(18)")
         l_tmp_string2 = l_tmp_string1
            + string(year(max(wr_due, asof_date)), "9999")
            + string(month(max(wr_due, asof_date)), "99")
            + string(day(max(wr_due, asof_date)), "99")
            + hi_char
         alloc_percent = 0.

      find last qad_wkfl
         where qad_key1 = "poa_det"
         and   qad_key2 >= l_tmp_string1
         and   qad_key2 <= l_tmp_string2
         no-lock no-error.

      if available qad_wkfl
      then do:

         begstr =  l_tmp_string1
            + substring(qad_key2,27,8)
            + pod_nbr.

         find qad_wkfl
            where qad_key1 = "poa_det"
            and   qad_key2 = begstr
            no-lock no-error.
         if available qad_wkfl
         then
            alloc_percent = qad_decfld[1].

      end. /* IF AVAILABLE qad_wkfl */

      if alloc_percent = 0
      then
         next. /* wr_route */

      if (wr_po_nbr = pod_nbr
      and wr_po_line = pod_line)
      then do:

         assign
            open_qty       = wr_qty_ord - wr_qty_comp
            /* BACK OFF FOR SAFETY LEADTIME */
            safety_date    = wr_due - pod_sftylt_days
            ship_dlvy_code = pod_sd_pat
            /* INTERPRET THE DUE DATE PER THE SHIP/DELIVERY */
            /* PATTERN CODE */
            interval_code  = "D"
            req_dt         = safety_date
            req_qty        = 0.  /* THIS DOESN'T MATTER SINCE DISCRETE */

         {gprun.i ""rcsdpint.p""}

         if resch_stat <> ""
         then do:
            warn_ct = warn_ct + 1.
            put unformatted
            skip(2)
            caps(getTermLabel("WARNING",10)) + ": " + resch_stat
            skip(1).
         end. /* IF resch_stat <> "" */

         ship_dlvy_date = resch_dt[1].

         /* GET THE ARRIVAL DATE WHICH IS DETERMINED BY LOOKING AT
         * THE SHIP-FROM AND SHIP-TO SITE CALENDARS (IF THERE ARE
         * ANY).  WE ALSO USE THE TRANSPORTATION LEADTIME IF THERE
         * IS ANY SO THAT WHEN WE TELL THEM TO SHIP, BOTH PARTIES
         * WILL BE OPERATING . */
         {gprun.i ""rcshipdt.p"" "(input po_vend,
                                   input pod_site,
                                   input ship_dlvy_date,
                                   input """",
                                   input pod_translt_days,
                                   output shipfrom_date,
                                   output shipfrom_time,
                                   output arrive_date,
                                   output arrive_time,
                                   output ret_status)"}

         if ret_status <> ""
         then do:
            warn_ct = warn_ct + 1.
            put unformatted
            skip(2)
            caps(getTermLabel("WARNING",10)) + ": " + ret_status
            wr_due
            skip(1).
         end. /* IF ret_status <> "" */

         assign
            work_qty = open_qty * (alloc_percent / 100)
            work_qty = work_qty / pod_um_conv
            work_qty = truncate(work_qty + .9999999999,0).

         if work_qty <> 0
         then do:
            create work_schd.
            assign
               schd_nbr       = pod_nbr
               schd_line      = pod_line
               schd_date      = arrive_date
               schd_time      = arrive_time
               schd_discr_qty = work_qty
               schd__chr01    = wr_lot
               schd__dec01    = wr_op .
         end. /* IF work_qty <> 0 */

         FORM /*GUI*/  header
            skip(2)
            header_desc format "x(80)"
            skip(1)
         with STREAM-IO /*GUI*/  width 132 no-box.

         if report_yn
         then do with frame frm2:

            /* SET EXTERNAL LABELS */
            setFrameLabels(frame frm2:handle).

            display
               wr_lot
               wo_type
               wo_status
               wr_op
               open_qty @ wo_qty_ord
               wr_due
               safety_date    column-label {&rssupa1_p_4}
               ship_dlvy_date column-label {&rssupa1_p_3}
               arrive_date    column-label {&rssupa1_p_2}
               alloc_percent
               work_qty       column-label {&rssupa1_p_5}
            with frame frm2 STREAM-IO /*GUI*/ .

         end. /* IF report_yn */

      end. /* IF (wr_po_nbr = pod_nbr */

   end. /* wr_route */

end. /* wo_mstr */
